home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / rkmbutclass.e < prev    next >
Text File  |  1995-04-13  |  14KB  |  461 lines
  1.  
  2. /****
  3.  
  4.     RKMbutClass.e
  5.  
  6.     Translated from RKMbutClass.c by Vidar Hokstad <vidarh@rforum.no>
  7.  
  8.     Please notice that this code is not as commented as it should
  9.     have been, and some of the utility code should have been
  10.     placed in it's own module. An improved version will be submitted
  11.     to AEE shortly.
  12.  
  13. ****/
  14.  
  15. OPT OSVERSION=37
  16. OPT PREPROCESS
  17.  
  18. MODULE 'exec/types','intuition/intuition','intuition/classes',
  19.         'intuition/classes','intuition/classusr','intuition/imageclass',
  20.         'intuition/gadgetclass','intuition/cghooks','intuition/icclass',
  21.         'utility/tagitem','utility/hooks','devices/inputevent',
  22.         'tools/boopsi','graphics/rastport','utility',
  23.         'intuition/screens','tools/installhook'
  24.  
  25.  
  26. #define INST_DATA(cl,o) ((o)+(cl.instoffset))
  27.  
  28. /***********************************************************/
  29. /****************      Class specifics      ****************/
  30. /***********************************************************/
  31.  
  32. #define RKMBUT_PULSE   (TAG_USER + 1)
  33.  
  34. OBJECT butINST
  35.     midx,midy    -> Coordinates of middle of gadget
  36. ENDOBJECT
  37.  
  38. /* The functions in this module:
  39.  
  40.     Class *initRKMButGadClass(void);
  41.     BOOL   freeRKMButGadClass(Class *);
  42.     ULONG  dispatchRKMButGad(Class *, Object *, Msg);
  43.     void   notifyPulse(Class *, Object *, ULONG, LONG, struct gpInput *);
  44.     ULONG  renderRKMBut(Class *, struct Gadget *, struct gpRender *);
  45.     void   geta4(void);
  46.     void   mainLoop(ULONG, ULONG);
  47.  
  48. ***/
  49.  
  50. /*************************************************************************************************/
  51. /* The main() function connects an RKMButClass object to a Boopsi integer gadget, which displays */
  52. /* the RKMButClass gadget's RKMBUT_Pulse value.  The code scales and move the gadget while it is */
  53. /* in place.                                                                                     */
  54. /*************************************************************************************************/
  55.  
  56. DEF pulse2int:PTR TO LONG
  57.  
  58. #define INTWIDTH  40
  59. #define INTHEIGHT 20
  60.  
  61. DEF w:PTR TO window
  62. DEF rkmbutcl:PTR TO iclass
  63. DEF integer:PTR TO gadget,but:PTR TO gadget
  64. DEF msg:PTR TO intuimessage
  65.  
  66. PROC main()
  67.  
  68.     pulse2int:= [ RKMBUT_PULSE, STRINGA_LONGVAL,TAG_END,0]
  69.  
  70.     IF utilitybase:= OpenLibrary('utility.library', 37)
  71.         IF w:= OpenWindowTagList(NIL,
  72.                 [WA_FLAGS,
  73.                     WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR WFLG_SIZEGADGET,
  74.                     WA_IDCMP, IDCMP_CLOSEWINDOW, WA_WIDTH,640,
  75.                     WA_HEIGHT, 200, TAG_END,0])
  76.  
  77.             WindowLimits(w, 450, 200, 640, 200)
  78.  
  79.             IF rkmbutcl := initRKMButGadClass()
  80.                 IF integer:= NewObjectA(NIL,'strgclass',[
  81.                                                 GA_ID,1,
  82.                                                 GA_TOP, w.bordertop + 5,
  83.                                                  GA_LEFT,w.borderleft+ 5,
  84.                                                 GA_WIDTH,INTWIDTH,
  85.                                                 GA_HEIGHT,INTHEIGHT,
  86.                                                 STRINGA_LONGVAL,0,
  87.                                                 STRINGA_MAXCHARS, 5,
  88.                                                 TAG_END,0])
  89.  
  90.                     IF but:= NewObjectA(rkmbutcl,NIL,
  91.                                     [GA_ID,2,
  92.                                     GA_TOP,w.bordertop + 5,
  93.                                      GA_LEFT,integer.leftedge +
  94.                                         integer.width + 5,
  95.                                     GA_WIDTH,40,
  96.                                     GA_HEIGHT,INTHEIGHT,
  97.                                     GA_PREVIOUS,integer,
  98.                                     ICA_MAP, pulse2int,
  99.                                     ICA_TARGET,integer,
  100.                                     TAG_END])
  101.  
  102.                         AddGList(w, integer, -1, -1, NIL)
  103.                         RefreshGList(integer, w, NIL, -1);
  104.  
  105.                         SetWindowTitles(w,'<-- Click to resize gadget Height',NIL)
  106.                         mainLoop(TAG_DONE,0)
  107.  
  108.                         SetWindowTitles(w,'<-- Click to resize gadget Width',NIL)
  109.                         mainLoop(GA_HEIGHT,100)
  110.  
  111.                         SetWindowTitles(w,'<-- Click to resize gadget Y position',NIL)
  112.                         mainLoop(GA_WIDTH,100)
  113.  
  114.                         SetWindowTitles(w,'<-- Click to resize gadget X position',NIL)
  115.                         mainLoop(GA_TOP, but.topedge + 20)
  116.  
  117.                         SetWindowTitles(w,'<-- Click to quit', NIL)
  118.                         mainLoop(GA_LEFT, but.leftedge + 20)
  119.  
  120.                         RemoveGList(w, integer, -1)
  121.                         DisposeObject(but)
  122.                     ENDIF
  123.                     DisposeObject(integer)
  124.                 ENDIF
  125.                 freeRKMButGadClass(rkmbutcl)
  126.             ENDIF
  127.             CloseWindow(w)
  128.         ENDIF    
  129.         CloseLibrary(utilitybase)
  130.     ENDIF
  131. ENDPROC
  132.  
  133.  
  134. PROC mainLoop(attr,value)
  135.  
  136.     SetGadgetAttrsA(but, w, NIL,[attr, value, TAG_DONE,0])
  137.  
  138.     LOOP
  139.       WaitPort(w.userport)
  140.         WHILE msg:= GetMsg(w.userport)
  141.             IF msg.class = IDCMP_CLOSEWINDOW THEN RETURN TRUE
  142.             ReplyMsg(msg)
  143.         ENDWHILE
  144.     ENDLOOP
  145. ENDPROC
  146.  
  147.  
  148.  
  149. /***********************************************************/
  150. /**    Make the class and set up the dispatcher's hook    **/
  151. /***********************************************************/
  152.  
  153. PROC initRKMButGadClass()
  154.  
  155.     DEF cl:PTR TO iclass
  156.  
  157.     cl:=0
  158.  
  159.     IF cl:=MakeClass(NIL,'gadgetclass',NIL,SIZEOF butINST,0)
  160.  
  161.         -> Initialize the dispatcher hook
  162.  
  163.         installhook(cl.dispatcher,{dispatchRKMButGad})
  164.     ENDIF
  165. ENDPROC cl
  166.  
  167.  
  168. /***********************************************************/
  169. /******************     Free the class      ****************/
  170. /***********************************************************/
  171.  
  172. PROC freeRKMButGadClass(cl)
  173. ENDPROC FreeClass(cl)
  174.  
  175.  
  176. /***********************************************************/
  177. /**********       The RKMBut class dispatcher      *********/
  178. /***********************************************************/
  179.  
  180. PROC dispatchRKMButGad(cl:PTR TO iclass,o:PTR TO object,msg:PTR TO msg)
  181.  
  182.     DEF inst:PTR TO butINST
  183.     DEF retval = FALSE
  184.     DEF object:PTR TO object,methodID
  185.     DEF g:PTR TO gadget,gpi:PTR TO gpinput,ie:PTR TO inputevent
  186.     DEF rp:PTR TO rastport
  187.     DEF x,y,w,h,code,pens:PTR TO INT
  188.  
  189.     methodID:=msg.methodid
  190.     SELECT methodID
  191.         CASE OM_NEW      /* First, pass up to superclass */
  192.  
  193.             IF object := dosupermethod(cl, o, msg)
  194.  
  195.                 g := object
  196.  
  197.                 -> Initial local instance data
  198.  
  199.                 inst := INST_DATA(cl, object)
  200.                 inst.midx := g.leftedge + (g.width / 2)
  201.                 inst.midy := g.topedge + (g.height / 2)
  202.                 inst.hidden:= FALSE
  203.  
  204.                 retval := object
  205.             ENDIF
  206.  
  207.         CASE GM_HITTEST
  208.  
  209.             -> Since this is a rectangular gadget this
  210.             -> method always returns GMR_GADGETHIT.
  211.  
  212.             retval := GMR_GADGETHIT
  213.  
  214.         CASE GM_GOACTIVE
  215.  
  216.             inst := INST_DATA(cl, o)
  217.                         /* Only become active if the GM_GOACTIVE   */
  218.                         /* was triggered by direct user input.     */
  219.             IF (msg::gpinput.ievent)
  220.                        /* This gadget is now active, change    */
  221.                        /* visual state to selected and render. */
  222.                 o::gadget.flags := o::gadget.flags OR GFLG_SELECTED
  223.                 renderRKMBut(cl,o,msg)
  224.                 retval := GMR_MEACTIVE
  225.             ELSE        /* The GM_GOACTIVE was not         */
  226.                         /* triggered by direct user input. */
  227.                 retval := GMR_NOREUSE
  228.             ENDIF
  229.         CASE GM_RENDER
  230.             retval    := renderRKMBut(cl,o,msg)
  231.         CASE GM_HANDLEINPUT   /* While it is active, this gadget sends its superclass an        */
  232.                                /* OM_NOTIFY pulse for every IECLASS_TIMER event that goes by     */
  233.                                /* (about one every 10th of a second).  Any object that is        */
  234.                                /* connected to this gadget will get A LOT of OM_UPDATE messages. */
  235.  
  236.             g := o
  237.             gpi := msg
  238.             ie:= gpi.ievent
  239.  
  240.             inst:= INST_DATA(cl, o)
  241.  
  242.             retval:= GMR_MEACTIVE
  243.  
  244.             IF (ie.class = IECLASS_RAWMOUSE)
  245.                 code:=ie.code
  246.                 SELECT code
  247.                     CASE SELECTUP    /* The user let go of the gadget so return GMR_NOREUSE    */
  248.                                     /* to deactivate and to tell Intuition not to reuse       */
  249.                                     /* this Input Event as we have already processed it.      */
  250.  
  251.                                     /*If the user let go of the gadget while the mouse was    */
  252.                                     /*over it, mask GMR_VERIFY into the return value so       */
  253.                                     /*Intuition will send a Release Verify (GADGETUP).        */
  254.  
  255.                         x:=gpi.mousex;y:=gpi.mousey
  256.  
  257.  
  258.                         IF (x < 0) OR
  259.                             (x > g.width) OR
  260.                             (y < 0) OR
  261.                             (y > g.height)
  262.  
  263.                             retval := GMR_NOREUSE
  264.                         ELSE
  265.                             retval := GMR_NOREUSE OR GMR_VERIFY
  266.                         ENDIF
  267.                                    /* Since the gadget is going inactive, send a final   */
  268.                                    /* notification to the ICA_TARGET.                    */
  269.                         notifyPulse(cl,o,0,inst.midx,msg)
  270.                     CASE MENUDOWN /* The user hit the menu button. Go inactive and let      */
  271.                                   /* Intuition reuse the menu button event so Intuition can */
  272.                                   /* pop up the menu bar.                                   */
  273.                         retval := GMR_REUSE
  274.  
  275.                                 /* Since the gadget is going inactive, send a final   */
  276.                                 /* notification to the ICA_TARGET.                    */
  277.                         notifyPulse(cl , o, 0,inst.midx,msg)
  278.                     DEFAULT
  279.                         retval := GMR_MEACTIVE
  280.                 ENDSELECT
  281.             ELSEIF (ie.class = IECLASS_TIMER)
  282.                         /* If the gadget gets a timer event, it sends an interim OM_NOTIFY */
  283.                 notifyPulse(cl, o, OPUF_INTERIM, inst.midx, gpi) /*     to its superclass. */
  284.  
  285.             ENDIF
  286.         CASE GM_GOINACTIVE           /* Intuition said to go inactive.  Clear the GFLG_SELECTED */
  287.                                       /* bit and render using unselected imagery.                */
  288.             o::gadget.flags := And(o::gadget.flags,Not(GFLG_SELECTED))
  289.             renderRKMBut(cl,o,msg)
  290.  
  291.         CASE OM_SET /* Although this class doesn't have settable attributes, this gadget class   */
  292.                     /* does have scaleable imagery, so it needs to find out when its size and/or */
  293.                     /* position has changed so it can erase itself, THEN scale, and rerender.    */
  294.  
  295.             inst:= INST_DATA(cl, o)
  296.  
  297.             g:= o
  298.  
  299.             x:= g.leftedge
  300.             y:= g.topedge
  301.             w:= g.width
  302.             h:= g.height
  303.  
  304.             IF( FindTagItem(GA_WIDTH, msg::opset.attrlist) OR
  305.                  FindTagItem(GA_HEIGHT,msg::opset.attrlist) OR
  306.                  FindTagItem(GA_TOP, msg::opset.attrlist) OR
  307.                  FindTagItem(GA_LEFT, msg::opset.attrlist) )
  308.  
  309.                 retval:= dosupermethod(cl, o, msg)
  310.  
  311.                 -> Get pointer to RastPort for gadget.
  312.  
  313.                 IF rp:= ObtainGIRPort( msg::opset.ginfo)
  314.  
  315.                     pens:= msg::opset.ginfo::gadgetinfo.drinfo::drawinfo.pens
  316.  
  317.                     SetAPen(rp, pens[BACKGROUNDPEN])
  318.                     SetDrMd(rp, RP_JAM1)        -> Erase the old gadget.
  319.                     RectFill(rp, x, y, x+w, y+h)
  320.  
  321.                     inst.midx := g.leftedge + (g.width / 2)    -> Recalculate where the
  322.                     inst.midy := g.topedge + (g.height / 2)    -> center of the gadget is.
  323.  
  324.                     -> Rerender the gadget.
  325.  
  326.                     domethod(o,[GM_RENDER, msg::opset.ginfo, rp, GREDRAW_REDRAW])
  327.                     ReleaseGIRPort(rp);
  328.                 ENDIF
  329.             ELSE
  330.                 retval := dosupermethod(cl, o, msg)
  331.             ENDIF
  332.         DEFAULT    -> rkmbutclass does not recognize the methodID, let the superclass's
  333.                 -> dispatcher take a look at it.
  334.             retval := dosupermethod(cl, o, msg)
  335.     ENDSELECT
  336. ENDPROC retval
  337.  
  338.  
  339.  
  340. /*************************************************************************************************/
  341. /************** Build an OM_NOTIFY message for RKMBUT_Pulse and send it to the superclass. *******/
  342. /*************************************************************************************************/
  343.  
  344. PROC notifyPulse(cl:PTR TO iclass,o:PTR TO object,flags,mid,gpi:PTR TO gpinput)
  345.     DEF tags:PTR TO LONG,msg:PTR TO LONG,inst:PTR TO butINST
  346.  
  347.     inst:= INST_DATA(cl,o)
  348.  
  349.     tags:= [RKMBUT_PULSE,mid - (gpi.mousex + o::gadget.leftedge),
  350.             GA_ID, o::gadget.gadgetid, TAG_DONE,0]
  351.  
  352.     msg:= [OM_NOTIFY, tags, gpi.ginfo, flags]
  353.     msg[0]:=OM_NOTIFY            -> Because this field will be changed
  354.                                 -> we have to reset it, since E's
  355.                                 -> lists are static unless they are NEW'ed
  356.  
  357.     dosupermethod(cl, o, msg)
  358.  
  359. ENDPROC
  360.  
  361.  
  362. /*************************************************************************************************/
  363. /*******************************   Erase and rerender the gadget.   ******************************/
  364. /*************************************************************************************************/
  365.  
  366. PROC renderRKMBut(cl:PTR TO iclass,g:PTR TO gadget,msg:PTR TO gprender)
  367.     DEF inst:PTR TO butINST
  368.     DEF rp:PTR TO rastport
  369.  
  370.     DEF retval = TRUE
  371.     DEF pens:PTR TO INT
  372.     DEF back,shine,shadow,w,h,x,y
  373.  
  374.     inst:=INST_DATA(cl,g)
  375.     pens:= msg.ginfo::gadgetinfo.drinfo::drawinfo.pens
  376.  
  377.     IF msg.methodid = GM_RENDER    /* If msg is truly a GM_RENDER message (not a gpInput that */
  378.                                 /* looks like a gpRender), use the rastport within it...   */
  379.         rp := msg.rport
  380.     ELSE                        /* ...Otherwise, get a rastport using ObtainGIRPort().     */
  381.         rp := ObtainGIRPort(msg.ginfo)
  382.     ENDIF
  383.  
  384.     IF rp
  385.         IF And(g.flags,GFLG_SELECTED)    -> If the gadget is selected, reverse the meanings of the
  386.                                         -> pens.
  387.             back   := pens[FILLPEN]
  388.             shine  := pens[SHADOWPEN]
  389.             shadow := pens[SHINEPEN]
  390.         ELSE
  391.             back   := pens[BACKGROUNDPEN]
  392.             shine  := pens[SHINEPEN]
  393.             shadow := pens[SHADOWPEN]
  394.         ENDIF
  395.  
  396.         SetDrMd(rp,RP_JAM1)
  397.  
  398.         SetAPen(rp, back)    -> Erase the old gadget.
  399.  
  400.         RectFill(rp, g.leftedge,
  401.                  g.topedge,
  402.                  g.leftedge + g.width,
  403.                  g.topedge + g.height)
  404.  
  405.         SetAPen(rp, shadow)    -> Draw shadow edge.
  406.  
  407.         Move(rp, g.leftedge + 1, g.topedge + g.height)
  408.         Draw(rp, g.leftedge + g.width, g.topedge + g.height)
  409.         Draw(rp, g.leftedge + g.width, g.topedge + 1)
  410.  
  411.  
  412.         w := g.width / 4        -> Draw Arrows - Sorry, no frills imagery
  413.         h := g.height / 2
  414.         x := g.leftedge + (w/2)
  415.         y := g.topedge + (h/2)
  416.  
  417.         Move(rp, x, inst.midy)
  418.         Draw(rp, x + w, y)
  419.         Draw(rp, x + w, y + g.height - h)
  420.         Draw(rp, x, inst.midy)
  421.  
  422.         x := g.leftedge + (w/2) + (g.width / 2)
  423.  
  424.         Move(rp, x + w, inst.midy)
  425.         Draw(rp, x, y)
  426.         Draw(rp, x, y  + g.height - h)
  427.         Draw(rp, x + w, inst.midy)
  428.  
  429.  
  430.         SetAPen(rp, shine)    -> Draw shine edge.
  431.  
  432.         Move(rp, g.leftedge,g.topedge + g.height - 1)
  433.         Draw(rp, g.leftedge,g.topedge)
  434.         Draw(rp, g.leftedge + g.width - 1, g.topedge)
  435.  
  436.         IF (msg.methodid <> GM_RENDER)    -> If we allocated a rastport, give it back.
  437.             ReleaseGIRPort(rp)
  438.         ENDIF
  439.     ELSE
  440.         retval := FALSE
  441.     ENDIF
  442. ENDPROC retval
  443.  
  444.  
  445. PROC dosupermethod(cl:PTR TO iclass,obj:PTR TO object,msg:PTR TO msg)
  446.   DEF h:PTR TO hook,o:PTR TO object,dispatcher
  447.   IF obj
  448.     h:=cl.super
  449.     dispatcher:=h.entry      /* get dispatcher from hook in superclass */
  450.     MOVE.L h,A0
  451.     MOVE.L msg,A1
  452.     MOVE.L obj,A2
  453.     MOVE.L dispatcher,A3
  454.     JSR (A3)                 /* call classDispatcher() */
  455.     RETURN D0
  456.   ENDIF
  457. ENDPROC NIL
  458.  
  459.  
  460. CHAR    '\0$VER: RKMbutClass 37.1',0
  461.